home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostuf / pattern2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-25  |  2.4 KB  |  160 lines
  1. program assemblergogo;
  2. {
  3.     Patterns
  4.     - by Bjarke Viksφe
  5.     feb 1994
  6.  
  7.   THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  8.   YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  9.   E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
  10.  
  11.     Second version of my first program ever on PC :->
  12.     A bit faster I think!
  13.     Can now do DPMI
  14. }
  15.  
  16.  
  17. const
  18.     width = 320;
  19.  
  20. var
  21.     oldmode, oldpage : shortint;
  22.     i, j             : integer;
  23.     ytaller          : integer;
  24.     xtabel           : array [0..319] of integer;
  25.     ytabel           : array [0..255] of integer;
  26.  
  27.  
  28. (*-----------------------------------------------------------*)
  29.  
  30. procedure VBLANK;
  31. begin
  32.       asm
  33.       mov     dx,$3DA
  34. @vent1:
  35.       in      al,dx
  36.       test    al,8
  37.       jz      @vent1
  38. @vent2:
  39.       in      al,dx
  40.       test    al,8
  41.       jnz     @vent2
  42.       end;
  43. end;
  44.  
  45.  
  46. (*-----------------------------------------------------------*)
  47.  
  48. procedure SetColor(nr : integer; r,g,b : byte);
  49. begin
  50.       asm
  51.       mov    bx,nr
  52.       mov    cl,r
  53.       mov    ch,g
  54.      mov    dh,b
  55.      mov    ax,$1010
  56.       int    $10
  57.       end;
  58. end;
  59.  
  60. procedure OpenScreen;
  61. var
  62.     i, color : integer;
  63. begin
  64.     asm
  65.     mov     ah,$0F
  66.     int     $10
  67.     mov     oldmode,al
  68.  
  69.     mov     al,$13
  70.     xor     ah,ah
  71.     int     $10
  72.     end;
  73.  
  74.     color := 0;
  75.     for i:=1 to 63 do begin
  76.         SetColor(i, color,color,color);
  77.         inc(color);
  78.     end;
  79.     for i:=64 to 127 do begin
  80.         SetColor(i, color,color,color);
  81.         dec(color);
  82.     end;
  83. end;
  84.  
  85. procedure CloseScreen;
  86. begin
  87.      asm
  88.      mov    al,oldmode
  89.       xor    ah,ah
  90.       int    $10
  91.       end;
  92. end;
  93.  
  94.  
  95. (*-----------------------------------------------------------*)
  96.  
  97. procedure SetupDemo;
  98. begin
  99.     for i:=0 to 319 do xtabel[i]:=sqr(i-160);
  100.     for i:=0 to 199 do ytabel[i]:=sqr(i-100);
  101. end;
  102.  
  103. (*-----------------------------------------------------------*)
  104.  
  105. procedure MakePattern(value : byte);
  106. begin
  107.     ytaller := 200;
  108.     asm
  109.     mov     ax,SEGA000
  110.     mov     es,ax
  111.     mov     di,0
  112.  
  113.     lea    bx,ytabel
  114.     mov    cl,value
  115.     mov    ch,127
  116.     cld
  117. @yloop:
  118.     mov    dl,160
  119.     lea    si,xtabel
  120. @xloop1:
  121.     lodsw
  122.     add    ax,[bx]
  123.     shr    ax,cl
  124.     and    al,ch
  125.     mov    dh,al
  126.  
  127.     lodsw
  128.     add    ax,[bx]
  129.     shr    ax,cl
  130.     and    al,ch
  131.     mov    ah,al
  132.     mov    al,dh
  133.     stosw
  134.     dec    dl
  135.     jnz    @xloop1
  136.  
  137.     add    bx,2
  138.     dec    ytaller
  139.     jnz    @yloop
  140.     end;
  141. end;
  142.  
  143.  
  144.  
  145. begin
  146.     SetupDemo;
  147.     OpenScreen;
  148.     for j:=1 to 4 do begin
  149.         for i:=0 to 16 do begin
  150.             VBLANK;
  151.             MakePattern(i);
  152.         end;
  153.         for i:=15 downto 1 do begin
  154.             VBLANK;
  155.             MakePattern(i);
  156.         end;
  157.     end;
  158.     CloseScreen;
  159. end.
  160.